perm filename JUSTFY.F4[NEW,LCS]14 blob
sn#496791 filedate 1980-02-02 generic text, type T, neo UTF8
00100 C*************** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
00200 SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
00300 CC IMPLICIT INTEGER(A-Q,S-Z)
00400 CC REAL EXTEN,PRCNT,ACCX,SPFAC
00500 COMMON /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
00600 CC COMMON /STF/RSTFAC(0/7),RSTJ2 /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
00700 DIMENSION IR(2,250),R(2,250),RN(1),NO(1),NP(1),RSTFAC(0/1)
00800 DATA RBX/6.0/,RBZ/8.0/,SPFAC/0.20/
00900 CC DATA RSP/.5/,RI/4.5/
01000 CC RSP=.5
01100 CCC SPFAC=.5
01200 DO 11 KN=0,JLP
01300 RSPC=0
01400 R8=KN
01500 N=0
01600
01700 DO 2 K=1,KY
01800 L=NP(K)
01900 RL=RN(L)
02000 C RL=WDCNT-2
02100 RA=RN(L+1)
02200 C RA=CODE NUM.
02300 RB=RN(L+3)
02400 C RB=POSITION(P3)
02500 IF(RN(L+2).EQ.R8)GO TO 77
02600 C THIS STAFF?
02700 IF(RA.NE.4)GO TO 2
02800 C SKIPS HOMED NOTES (IN CHORDS)
02900 77 IF(RA.LT.3)GO TO 20
03000 IF(RA.EQ.4)GO TO 444
03100 IF(RA.EQ.3)GO TO 333
03200 C LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
03300 IF(RA.LT.17)GO TO 2
03400 GO TO 10
03500 333 IF(RL.LT.3)GO TO 10
03600 C <3 MEANS NOTHING IN P5
03700 IF(RN(L+5).GT.4)GO TO 2
03800 C NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
03900 GO TO 10
04000 444 IF(RL.GT.3.OR.RN(L+4).LT.0)GO TO 2
04100 C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
04200 CC FOR REPEAT BAR WDCNT IS 3 -- 10/77 444 IF(RL.GT.2)GO TO 2
04300 C SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
04400 GO TO 10
04500 20 IF(RA.NE.2)GO TO 113
04600 C ASSUMES WD CNT. IS GREAT ENOUGH!?!?!?!?
04700 IF(RN(L+6))GO TO 2
04800 IF(RN(L+7))GO TO 2
04900 C SKIP INVIS. RESTS AND RESTS WITH NEG. RHYTH. (PUT THIS IN OTHER JUST. PROGS.)
05000 GO TO 10
05100 113 IF(RL.LT.7)GO TO 10
05200 C NOW NOTES. SKIP IF NEG. VALUE IN P9 (IT'S A SUPPLEMENTAL NOTE.)
05300 IF(RN(L+9).LT.0)GO TO 2
05400 10 N=N+1
05500 R(1,N)=RB
05600 IR(2,N)=L
05700 IF(N.EQ.250)GO TO 28
05800 C ONLY TREATS 250 ITEMS AT A TIME.
05900 2 CONTINUE
06000
06100 IF(N.EQ.0)GO TO 11
06200 28 DO 23 K=1,N
06300 23 IF(RN(IR(2,K)+1).NE.4)GO TO 24
06400 C SKIPS IF ONLY BAR LINES ON THIS STAFF
06500 GO TO 11
06600 24 RSZ=RSTFAC(KN)*PRCNT
06700 CALL SORT2(R,N)
06800
06900 C JUMP IF LAST IS A BAR LINE.
07000 K=0
07100 JLDGR=0
07200 JX=0
07300 22 K=K+1
07400 122 L=IR(2,K)
07500 RA=RN(L+1)
07600 C RA IS NOW CODE NUM.
07700 RL=RN(L)
07800 C RL=WDCNT-2
07900 RB=0
08000 RD=0
08100 C RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
08200 RX=RN(L+5)
08300 C RX=PARAM 5
08400 RX6=RN(L+6)
08500 RY=1
08600 RW=AMOD(RN(L+4),100.)
08700 RSP=SPFAC*RSTFAC(IFIX(RN(L+2)))
08800 IF(RA.GT.1)GO TO 4
08900 RZ=RN(L+7)
09000 IF(LDGR.NE.JLDGR)JLDGR=0
09100 C CHECK FOR PRESENCE OF LEDGER LINES WITH SUCCESSIVE NOTES
09200 LDGR=0
09300 JK=K
09400 DO 32 JJ=JK+1,N+1
09500 K=JJ
09600 RB=R(1,JJ)-R(1,JJ-1)
09700 IF(RB.GT.0.1)GO TO 320
09800 C PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
09900 R(1,JJ)=R(1,JJ-1)
10000 GO TO 32
10100 320 IF(RB.GT.RSP)GO TO 35
10200 32 CONTINUE
10300 C FOUND HOW MANY MEMBERS TO CHORD.
10400 35 RB=0
10500 K=K-1
10600 RQ=0
10700 125 RC=ABS(RN(L+4))
10800
10900 IF(RC.LT.60)GO TO 637
11000 IF(RC.LT.180)RY=.6
11100 C FOUND A MINI-NOTE
11200
11300 637 RSDF=0
11400 IF(RA.EQ.1)GO TO 437
11500 C JUMP IF NOTE
11600 RDF=-1
11700 C NOW IT'S ANYTHING BUT A NOTE
11800 GO TO 137
11900 437 IF(RL.LT.8)GO TO 237
12000 C JUMP IF THERE IS NOT P10 TO LOOK AT
12100 RW=RN(L+10)
12200 C PUT P10 INTO RW
12300 GO TO 337
12400 237 RW=0
12500 337 IF(RDF.LT.0)GO TO 537
12600 C JUMP IF PREVIOUS WAS NOT A NOTE
12700 IF(RW.EQ.RDF)GO TO 137
12800 C SKIP TO FAR END OF LOOP IF THINGS ARE ON DIFF. STAVES. (CLEFS?, ETC?)
12900 RSDF=-1
13000 537 RDF=RW
13100 C SAVE STAFF INFO FOR NEXT TIME AROUND.
13200
13300 137 DO 37 JJ=JK,K
13400 C******* IF(RD.NE.0)GO TO 38
13500 C FINDS ONLY HIGH OR! LOW LED. LINE.
13600 JR=IR(2,JJ)
13700 RW=AMOD(RN(JR+4),100.)
13800 IF(RW.GT.12)GO TO 277
13900 IF(RW.GE.2)GO TO 38
14000 277 LDGR=-1
14100 IF(RW.GT.11)LDGR=1
14200 IF(JLDGR.EQ.LDGR)GO TO 36
14300 JLDGR=LDGR
14400 C LDGR IS FOR LEDGER LINES.
14500 GO TO 38
14600 36 IF(RD.GE.1.5)GO TO 38
14700 RD=1.5
14800 RQ=RD
14900 38 IF(RB.GT.2)GO TO 222
15000 C JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
15100 RZZ=RN(JR+7)
15200 RE=RN(JR+5)
15300 IF(RB.GE.2)GO TO 477
15400 RC=1.5
15500 IF(RZZ.LT.10)GO TO 378
15600 IF(RZZ.GE.20)RC=3.
15700 C 10=DOT, 20=DOUBLE DOT
15800 GO TO 377
15900 378 IF(RE.GE.20)GO TO 477
16000 IF(AMOD(RZZ,10.).EQ.0)GO TO 477
16100 377 RB=RC+EXTEN(RZZ)
16200 C SPACE FOR DOT OR TAIL(IF STEM UP)
16300 477 IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
16400 C FOR CHORD TONES ON RIGHT OF STEM UP.
16500 C LOOKS THROUGH ALL NOTES OF A CHORD.
16600 222 RC=AMOD(RE,10.0)
16700 IF(RC.EQ.0)GO TO 37
16800 C JUMP IF NO ACCIS. NOW SEE IF THERE'S SPACE FOR ACCI.
16900 IF(RN(JIR+1).NE.1)GO TO 425
17000 C* RX=0
17100 C* IF(RN(JR).GE.8)RX=RN(JR+10)
17200 C* RXX=0
17300 C* IF(RN(JIR).GE.8)RXX=RN(JIR+10)
17400 C* RDF=0
17500 C* IF(RX.NE.RXX)RDF=100.
17600 C SAVE INFO ON NOTES ON DIFF. STAVES.
17700 C* IF(RXX.EQ.1.OR.RX.EQ.2)RDF=-RDF
17800 C**** THIS NEXT AREA PROBABLY NEEDS MORE WORK (2/78) ***********
17900 C JIR IS POINTER TO PREVIOUS ITEM. SKIP IF NOT A NOTE.
18000 KX=RC
18100 C KX=ACCI ON CURRENT NOTE
18200 RD=1
18300 C ADD A LITTLE SPACE FOR ACCI. ANYHOW.
18400 RX=RN(L+4)
18500 RXX=ABS(RX)
18600 C THIS NOTE
18700 577 IF(RXX.LT.80)GO TO 677
18800 C FIND MINIS, HARMONICS, ETC.
18900 RXX=RXX-100
19000 GO TO 577
19100 677 IF(RX)RXX=-RXX
19200 RX=RXX
19300 RDIF=RN(JIR+4)
19400 RXX=ABS(RDIF)
19500 777 IF(RXX.LT.80)GO TO 877
19600 C FIND MINIS, HARMONICS, ETC.
19700 RXX=RXX-100
19800 GO TO 777
19900 877 IF(RDIF)RXX=-RXX
20000
20100 RDIF=RX-RXX
20200 C HEIGHT DIFF. JUMP OUT IF TOO CLOSE TOGETHER. AMOD IS FOR GRACE NOTES, ETC.
20300 RX=3
20400 JSTM=RN(JIR+5)/10.0
20500 C JSTM=STEM DIRECTION OF PREVIOUS NOTE. 1=UP, 2=DOWN
20600 IF(RDIF.GT.0)GO TO 427
20700 C JUMP IF PREV NOTE IS BELOW. LIMITS: b OR NAT.=3, #=4
20800 IF(JSTM.NE.2)GO TO 424
20900 IF(AMOD(RN(JIR+7),10.0).GE.1)GO TO 425
21000 C JUMP IF PREV. NOTE HAS STEM DOWN WITH TAIL. THEN WE NEED SPACE.
21100 424 IF(KX.NE.2)RX=5
21200 GO TO 428
21300 427 IF(KX.EQ.2)RX=4
21400 C PREV NOTE IS ABOVE. LIMITS: b OR NAT.=5, #=3
21500 428 IF(ABS(RDIF).LT.RX)GO TO 425
21600 IF(RDIF)GO TO 426
21700 C JUMP IF THIS NOTE IS LOWER THAN PREV.
21800 IF(JSTM.NE.1)GO TO 426
21900 C NO BIG SPACE NEEDED IF PREV. NOTE HAS STEM DOWN AND IS BELOW.
22000
22100 425 RW=2.8
22200 IF(IFIX(AMOD(RE,10.0)).EQ.4)RW=4.8
22300 CATCHES DOUBLE FLAT (=4)
22400 RD=RW*RY+EXTEN(RE)+OTHSID(RN,JR)
22500 CGHB USE 2.8 FOR SIZE OF ACCIS (THEY'RE REALLY 3)425 RD=2*RY+EXTEN(RE)
22600 426 IF(RQ.GT.RD)RD=RQ
22700 RQ=RD
22800 C FUNCT. EXTEN=AMOD(X,1.)*10.
22900 37 CONTINUE
23000
23100 IF(RY.NE.1)RB=RB-.5*RJSZ
23200 C MINI NOTES NEED LESS SPACE
23300 250 IF(RSDF)GO TO 17
23400 ACCX=0
23500 CC RC=0
23600 JIR=JX+2
23700 IF(JIR.GE.N)GO TO 25
23800 RW=R(1,JIR-1)
23900
24000 DO 132 JJ=JIR,N
24100 IF(RW.NE.R(1,JJ))GO TO 25
24200 KX=IR(2,JJ)
24300 C GET POINTER
24400 IF(RN(KX+1).NE.1)GO TO 25
24500 C ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
24600 CC RE=ABS(RN(KX+6))
24700 CC IF(RE.GE.10)RC=-2.6
24800 CC IF(RE.EQ.20)RC=-RC
24900 RC=OTHSID(RN,KX)
25000 RE=AMOD(RN(KX+5),10.0)
25100 C FIND AN ACCI
25200 IF(RE.GE.1)RC=RC+2
25300 IF(IFIX(RE).EQ.4)RC=RC+2
25400 C FOUND AN ACCI RE=4=DOUBLE FLAT
25500 RC=AMOD(RE,1.0)*10.0+RC
25600 C ADD ANY EXTENSION TO THE LEFT
25700 IF(RC.GT.ACCX)ACCX=RC
25800 CC RC=0
25900 IF(ACCX.GT.RD)RD=ACCX
26000 132 CONTINUE
26100 GO TO 25
26200
26300 4 IF(RA.NE.2)GO TO 33
26400 C NEXT FOR DOTTED RESTS - IN P6
26500 IF(RL.GE.4)RB=RN(L+6)*1.5
26600 C NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
26700 GO TO 250
26800 33 IF(RA.NE.3)GO TO 29
26900 RB=3
27000 IF(RN(L+4).GT.80)RB=1.5
27100 C CHECK ON SIZE NEEDED FOR CLEFS. >80 = MINICLEF
27200 29 IF(RA.NE.4)GO TO 26
27300 C BAR LINES
27400 IF(RN(L+4).LT.0)GO TO 17
27500 C SKIP IF INVISIBLE BAR LINE (FOR PAGE PROGRAM )
27600 RB=-RJSZ/2
27700 RD=.9
27800 KX=RN(L+4)/1000.
27900 IF(KX.LE.0.)GO TO 25
28000 RD=RD+1.2
28100 C ADD A LITTLE SPACE IN FRONT OF DBL BAR.
28150 IF(KX.GT.1)GO TO 229
28200 IF(RL.LT.3)GO TO 25
28250 C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN P5.
28300 CCC IF(KX.EQ.1.OR.KX.EQ.3)RD=RD+RD
28350 229 IF(KX.NE.2)RD=RD+RD
28375 C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
28400 C REPT BAR WITH DOTS TO LEFT. ADD SPACE IN FRONT OF IT.
28500 RB=-RB/RBX
28550 IF(KX.EQ.4)KX=0
28600 129 IF(KX.GE.2)RB=RBZ*RB
28700 C IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
28800 GO TO 25
28900
29000 26 IF(RA.NE.18)GO TO 30
29100 C METER
29200 RC=0
29300 IF(RL.GE.7)RC=9
29400 C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
29500 RB=-1
29600 RD=1
29700 IF(RX6.LE.9.AND.RX.LE.9)GO TO 31
29800 C CHECKS FOR 2-DIGIT METERS
29900 RD=2
30000 RB=0
30100 31 RB=RB+RC
30200 GO TO 25
30300 30 IF(RA.NE.17)GO TO 17
30400 C KSIG
30500 RX=ABS(RX)
30600 IF(RX.GE.100)RX=RX-100
30700 C +100 FOR NATURALS AS KEYSIG.
30800 RB=2*(RX-1)-2
30900 C SPACES FOR CORRECT NUM OF ACCIS. RX=NUM OF ACCIS.
31000 RD=2
31100 25 IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSZ
31200 17 RC=(RB+RJSZ)*RSZ
31300 C RJSZ=DEFAULT SIZE
31400 JIR=L
31500 C SAVE THE POINTER FOR ACCI. CHECK AT 110
31600 JX=K
31700 R(2,JX)=RC
31800 3 IF(K.LT.N)GO TO 22
31900 RA=R(1,1)
32000 RB=R(2,1)
32100
32200 DO 13 KX=2,JX
32300 RE=R(1,KX)
32400 C POS. BEFORE SHIFTING
32500 IF(ABS(RE-RA).GT.RSP)GO TO 14
32600 CCC IF(ABS(RE-RA).GT..5)GO TO 14
32700 IF(R(2,KX).GT.RB)GO TO 16
32800 C SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
32900 GO TO 13
33000 C JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
33100 14 RD=RA+RB-RE
33200 IF(RD.LE.0)GO TO 16
33300 C THERE'S ENOUGH ROOM
33400 ROV=ROV+RD
33500 140 R4=RE+RSPC-.001
33600 R5=10000
33700 R8=RD
33800 R9=0
33900 C GO EXPAND IT
34000 IF(R(2,KX).EQ.0)GO TO 15
34100 CALL MOVIT(RN,NO,R4,R5,R8,R9)
34200 C???? IF(R2.LE.4)GO TO 15
34300 C SKIP NEXT IF COMING FROM 'PAGE' OR 'JUST'
34400 IF(R2.LE.7)GO TO 15
34500 R5=R4
34600 R4=RA+.001+RSPC
34700 R8=R4
34800 R9=R5+RD-.001
34900 C FOR ITEMS ON OTHER LINES.
35000 CALL MOVIT(RN,NO,R4,R5,R8,R9)
35100 15 RSPC=RSPC+RD
35200 C RSPC SAVES TOTAL SPACE ADDED
35300 16 RB=R(2,KX)
35400 13 RA=RE
35500 11 CONTINUE
35600 END
35700
35800 FUNCTION OTHSID(RN,J)
35900 DIMENSION RN(1)
36000 OTHSID=0
36100 A=ABS(RN(J+6))
36200 IF(A.GE.10)OTHSID=-2.6
36300 C OTHSID=SPACE NEEDED (+ OR -) BECAUSE OF NOTE ON 'WRONG' SIDE OF STEM.
36400 IF(A.GE.20)OTHSID=-OTHSID
36500 END